home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #2 / Ham Radio 2000 - Volume 2.iso / HAMV2 / MISC / HCAL-27 / METSHOWR.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1997-03-30  |  15.8 KB  |  509 lines
  1. 10  'METSHOWR - Meteor Shower Predictor - 22 MAR 97 rev.30 MAR 97
  2. 20  CLS:KEY OFF:COLOR 7,0,1
  3. 30  IF EX$=""THEN EX$="EXIT"
  4. 40  UL$=STRING$(80,205)
  5. 50  DIM LDATE(400),LTIME(400),LELEV(400),LAZIM(400)
  6. 60  '
  7. 70  '.....start
  8. 80  CLS:COLOR 15,2
  9. 90  PRINT " METEOR SHOWER PREDICTIONS";TAB(57)"by Michael R. Owen W9IP ";
  10. 100  PRINT STRING$(80,32);
  11. 110  LOCATE CSRLIN-1,20:PRINT "edited for HAMCALC by George Murphy VE3ERP";
  12. 120  COLOR 1,0:PRINT STRING$(80,223);:COLOR 7,0
  13. 130  GOSUB 4660
  14. 140  COLOR 0,7:LOCATE ,24:PRINT " Press 1 to continue or 0 to EXIT ":COLOR 7,0
  15. 150  Z$=INKEY$:IF Z$=""THEN 150
  16. 160  IF Z$="0"THEN CLS:RUN EX$
  17. 170  IF Z$="1"THEN LOCATE CSRLIN-1:PRINT UL$;:GOTO 190
  18. 180  GOTO 150
  19. 190  COLOR 0,7:PRINT " Define your QTH: ":COLOR 7,0
  20. 200  PRINT " ENTER: Latitude in decimal degrees  (+<UNK! {00F8}> if North, -<UNK! {00F8}> if South)";
  21. 210  INPUT MYLATD:IF MYLATD<0 THEN LA$="S"ELSE LA$="N"
  22. 220  PRINT " ENTER: Longitude in decimal degrees  (+<UNK! {00F8}> if East, -<UNK! {00F8}> if West) ";
  23. 230  INPUT MYLOND:IF MYLOND<0 THEN LO$="W"ELSE LO$="E"
  24. 240  CLS
  25. 250  DEF FNACOS(X)=1.5708-ATN(X/SQR(1-X*X))  'arccos
  26. 260  DEF FNARSIN(X)= ATN(X/SQR(1-X*X))               'arcsin
  27. 270  '
  28. 280  '.....main menu
  29. 290  LENG=0:INCR=0:COUNTR=0:ENDER=1:BEST=0:HEADER=0:OPTDIR=0:BESEL=90
  30. 300  GOSUB 4580
  31. 310  '
  32. 320  CLS
  33. 330  PRINT " Press number in ( ) to select:"
  34. 340  PRINT UL$;
  35. 350  PRINT "  (1) Peak Time Prediction"
  36. 360  PRINT "  (2) Peak Time Prediction + Graph of AZ/EL of Radiant for a ";
  37. 370  PRINT "Particular Path"
  38. 380  PRINT "  (3) Listing of Good Times for All Paths"
  39. 390  PRINT "  (4) Best Path for a Particular Time"
  40. 400  PRINT
  41. 410  PRINT "  (0) Program Main Menu"
  42. 420  Z$=INKEY$:IF Z$=""THEN 420
  43. 430  WHICH=VAL(Z$)
  44. 440  IF WHICH<1 THEN 70
  45. 450  IF WHICH>4 THEN 420
  46. 460  IF WHICH<>2 THEN 710 ELSE 490
  47. 470  GOTO 420
  48. 480  '
  49. 490  CLS: PRINT " Press letter in ( ) to select direction from your QTH at";
  50. 500  PRINT USING "###.#<UNK! {00F8}>";ABS(MYLATD);:PRINT LA$;USING "####.#<UNK! {00F8}>";ABS(MYLOND);
  51. 510  PRINT LO$
  52. 520  PRINT UL$;
  53. 530  PRINT " (a) North":PRINT " (b) Northeast": PRINT " (c) East"
  54. 540  PRINT " (d) Southeast": PRINT " (e) South": PRINT " (f) Southwest"
  55. 550  PRINT " (g) West": PRINT " (h) Northwest"
  56. 560  PRINT " (i) To a Specific Location"
  57. 570  PRINT " (j) Specific bearing (0<UNK! {00F8}>-360<UNK! {00F8}>) from your QTH"
  58. 580  Z$=INKEY$:IF Z$=""THEN 580
  59. 590  Z=ASC(Z$)
  60. 600  IF Z<97 OR Z>106 THEN 580 ELSE DIRECTION = Z-96
  61. 610  IF WHICH <>2 THEN 710
  62. 620  IF Z$="i"THEN 630 ELSE 690
  63. 630  COLOR 0,7:PRINT " Define the Specific Location: ":COLOR 7,0
  64. 640  PRINT " ENTER: Latitude in decimal degrees  (+<UNK! {00F8}> if North, -<UNK! {00F8}> if South)";
  65. 650  INPUT HISLATD:IF HISLATD<0 THEN LA$="S"ELSE LA$="N"
  66. 660  PRINT " ENTER: Longitude in decimal degrees  (+<UNK! {00F8}> if East, -<UNK! {00F8}> if West) ";
  67. 670  INPUT HISLOND:IF HISLOND<0 THEN LO$="W"ELSE LO$="E"
  68. 680  GOSUB 3450
  69. 690  IF Z$="j"THEN INPUT " ENTER: Bearing (decimal degrees)";LOOK
  70. 700  '
  71. 710  CLS
  72. 720  PRINT  "      METEOR SHOWER" TAB(23);"APPROX.DATE"
  73. 730  PRINT
  74. 740  PRINT "   (1)  QUADRANTIDS "TAB(25)"JAN  4"
  75. 750  PRINT "   (2)  LYRIDS      "TAB(25)"APR 22"
  76. 760  PRINT "   (3)  ETA AQUARIDS"TAB(25)"MAY  4"
  77. 770  PRINT "   (4)  ARIETIDS    "TAB(25)"JUN  7"
  78. 780  PRINT "   (5)  PERSEIDS    "TAB(25)"AUG 12"
  79. 790  PRINT "   (6)  DRACONIDS   "TAB(25)"OCT 10"
  80. 800  PRINT "   (7)  ORIONIDS    "TAB(25)"OCT 20"
  81. 810  PRINT "   (8)  LEONIDS     "TAB(25)"NOV 17"
  82. 820  PRINT "   (9)  GEMINIDS    "TAB(25)"DEC 13"
  83. 830  PRINT
  84. 840  COLOR 0,7:PRINT " Press number in ( ) for shower information ":COLOR 7,0
  85. 850  Z$=INKEY$:IF Z$=""THEN 850
  86. 860  SHOWER=VAL(Z$)
  87. 870  IF SHOWER <1 OR SHOWER >9 THEN 850
  88. 880  LOCATE CSRLIN-1:PRINT STRING$(80,32);:LOCATE CSRLIN-1
  89. 890  GOSUB 3840: IF WHICH=1 THEN 2600
  90. 900  IF WHICH=4 THEN PRINT:INPUT " ENTER: Time GMT (####)...";STARTTIME:CENT$="Y":GOTO 980
  91. 910  '
  92. 920  PRINT UL$;
  93. 930  LENG=2400:INCR=60
  94. 940  STARTTIME=0
  95. 950  '* STARTTIME=0 IS AUTOMATIC
  96. 960  '* THIS LOOP "LOOKS" AROUND THE COMPASS AT 45 DEGREE INCREMENTS
  97. 970  IF WHICH=3 THEN FOR DIRECTION = 1 TO 8
  98. 980  ROUNDS=0
  99. 990  TIME=STARTTIME
  100. 1000  TIMECOUNT=TIME
  101. 1010  FINISH=TIMECOUNT+LENG+100
  102. 1020  GOSUB 2690: T=S*15*R1
  103. 1030  IF COUNTR>0 THEN 1180
  104. 1040  '* INPUT RIGHT ASCENSION DATA: RAHOUR, RAMIN IN DATA STATEMENT.
  105. 1050  '* A$ IS HOURS, A2 IS MIN, A3 IS SEC.
  106. 1060  '* CHANGE THESE OR WRITE AN INPUT STATEMENT IF YOU WANT TO
  107. 1070  '* EVALUATE OTHER METEOR SHOWERS (OR OTHER CELESTIAL OBJECTS)
  108. 1080  A$= STR$(RAHOUR): A2=RAMIN: A3=0
  109. 1090  GOSUB 2630: R=A*15*R1
  110. 1100  '* INPUT DECLINATION, SAME COMMENTS AS ABOVE
  111. 1110  A$=STR$(DEC): A2=0: A3=0
  112. 1120  GOSUB 2630: DEG=A*R1
  113. 1130  IF WHICH<>4 THEN 1180
  114. 1140  PRINT: PRINT " ...PLEASE WAIT..."
  115. 1150  FOR BESTDIR=0 TO 355 STEP 5
  116. 1160  ANGLE=BESTDIR
  117. 1170  GOTO 1320
  118. 1180  IF WHICH=2 AND COUNTR=1 THEN 1350
  119. 1190  '* THIS SECTION CHOOSES PATHS IN 45 DEGREE STEPS
  120. 1200  IF DIRECTION=9 THEN GOSUB 3450:GOSUB 2990:GOTO 1380
  121. 1210  IF DIRECTION=1 THEN ANGLE=0:WAY$="North"
  122. 1220  IF DIRECTION=2 THEN ANGLE=45:WAY$="Northeast"
  123. 1230  IF DIRECTION=3 THEN ANGLE=90:WAY$="East"
  124. 1240  IF DIRECTION=4 THEN ANGLE=135:WAY$="Southeast"
  125. 1250  IF DIRECTION=5 THEN ANGLE=180:WAY$="South"
  126. 1260  IF DIRECTION=6 THEN ANGLE=225:WAY$="Southwest"
  127. 1270  IF DIRECTION=7 THEN ANGLE=270:WAY$="West"
  128. 1280  IF DIRECTION=8 THEN ANGLE=315:WAY$="Northwest"
  129. 1290  IF DIRECTION=10 THEN ANGLE=LOOK
  130. 1300  '* "RIGHT" AND "RIGHT2" ARE THE AZIMUTH OF POINTS AT
  131. 1310  '* 90 DEGREE ANGLES TO THE PATH OF INTEREST.
  132. 1320  RIGHT=(ANGLE+90) MOD 360:RIGHT2=(ANGLE+270) MOD 360
  133. 1330  IF WHICH=3 OR COUNTR=0 THEN IF ROUNDS=0 THEN GOSUB 4450
  134. 1340  IF ROUNDS=0 THEN MIDLATD=CIRLATD:MIDLOND=CIRLOND
  135. 1350  IF WHICH=2 AND COUNTR=0 THEN GOSUB 2990  'set up graph
  136. 1360  '* MIDLATD AND MIDLOND ARE THE SPOTS HALFWAY ALONG THE
  137. 1370  '* PATH OF INTEREST (THIS IS WHERE THE METEORS NEED TO BE).
  138. 1380  B=MIDLATD:L=MIDLOND
  139. 1390  B=B*R1:L=L*R1
  140. 1400  '* THIS SECTION DETERMINES THE AZ AND EL OF THE RADIANT BASED
  141. 1410  '* ON ITS R.A. AND DEC. AT PATH MIDPOINT.
  142. 1420  T5=T-R+L:REM LHA
  143. 1430  COSDEG=COS(DEG):SINDEG=SIN(DEG)
  144. 1440  SINB=SIN(B)
  145. 1450  S1=SINB*SINDEG
  146. 1460  COSINB=COS(B)
  147. 1470  S1=S1+COSINB*COSDEG*COS(T5)
  148. 1480  C1=1-S1*S1
  149. 1490  IF C1>0 THEN C1=SQR(C1)
  150. 1500  IF C1<=0 THEN 1520
  151. 1510  H=ATN(S1/C1):GOTO 1530
  152. 1520  H=SGN(S1)*P/2
  153. 1530  C2=(COSINB*SINDEG)-SINB*COSDEG*COS(T5)
  154. 1540  S2=-COSDEG*SIN(T5)
  155. 1550  IF C2=0 THEN A=SGN(S2)*P/2:GOTO 1580
  156. 1560  A=ATN(S2/C2)
  157. 1570  IF C2<0 THEN A=A+P
  158. 1580  IF A <0 THEN A=A+2*P
  159. 1590  ELEV=H/R1: AZIM=A/R1
  160. 1600  '* LOAD ARRAY WITH AZ, EL DATA
  161. 1610  IF WHICH<>2 THEN 1660
  162. 1620  LAZIM(ENDER)=AZIM
  163. 1630  LELEV(ENDER)=ELEV
  164. 1640  LDATE(ENDER)=DAY
  165. 1650  LTIME(ENDER)=TIME
  166. 1660  IF ELEV<0 THEN 1980
  167. 1670  QUAL=0: BEST=0
  168. 1680  '* ROUTINE TO INDICATE THE TIMES WHEN THE RADIANT IS
  169. 1690  '* WITHIN +/- 15 DEG OF PERPENDICULAR TO THE DESIRED
  170. 1700  '* PATH (GOOD) AND WHEN IT IS ALSO WITHIN +/- 15 DEG OF
  171. 1710  REM *** 45 DEG ELEVATION AT PATH MIDPOINT (BEST).
  172. 1720  TIM$=STR$(TIME):TIM$=RIGHT$(TIM$,LEN(TIM$)-1)+"z"
  173. 1730  IF LEN(TIM$)<5 THEN TIM$="0"+TIM$:GOTO 1730
  174. 1740  IF ELEV<20 AND WHICH=4 THEN 1800
  175. 1750  IF ELEV<20 THEN 1880
  176. 1760  IF (AZIM>(RIGHT-15) AND AZIM<(RIGHT+15)) OR (AZIM>(RIGHT2-15) AND AZIM<(RIGHT2+15)) THEN QUAL=1
  177. 1770  IF QUAL=1 AND ELEV>30 AND ELEV<60 THEN BEST=1
  178. 1780  IF WHICH<>4 THEN 1880
  179. 1790  IF BEST=1 AND ABS(45-ELEV)<ABS(45-BESTEL) THEN OPTDIR=ANGLE:BESTEL=ELEV
  180. 1800  NEXT BESTDIR
  181. 1810  COLOR 15
  182. 1820  IF OPTDIR>1 THEN 1860
  183. 1830  PRINT: PRINT " No Good Directions at ";TIM$
  184. 1840  PRINT: PRINT " RUN OPTION 2 TO CHECK IF RADIANT IS ABOVE HORIZON"
  185. 1850  COLOR 7:GOTO 2420
  186. 1860  PRINT:PRINT " Best Direction at ";TIM$;"  =";OPTDIR;"<UNK! {00F8}>"
  187. 1870  COLOR 7:GOTO 2420
  188. 1880  IF WHICH=3 THEN 1930
  189. 1890  IF QUAL=1 AND BEST=0 THEN LOCATE 23,10:PRINT "Good Time: ";TIM$
  190. 1900  COLOR 15
  191. 1910  IF BEST=1 AND ABS(45-ELEV)<ABS(45-BESEL) THEN BESEL=ELEV:BESTIME=TIME:BESTIM$=TIM$
  192. 1920  COLOR 7
  193. 1930  IF WHICH=3 AND HEADER=0 THEN GOSUB 3190
  194. 1940  IF QUAL=1 AND BEST=0 AND WHICH=3 THEN PRINT " "+TIM$,WAY$;:GOSUB 4890
  195. 1950  COLOR 15
  196. 1960  IF BEST=1 AND WHICH=3 THEN LOCATE ,30:PRINT TIM$,WAY$;:GOSUB 4890
  197. 1970  COLOR 7
  198. 1980  IF WHICH <>2 THEN 2180
  199. 1990  IF COUNTR<>0 THEN 2060
  200. 2000  LOCATE 21,5
  201. 2010  PRINT"NORTH                        SOUTH                        NORTH"
  202. 2020  '* PLOT THE APPROXIMATE AZ, EL DATA FOR
  203. 2030  '* THE RADIANT AS A FUNCTION OF TIME.
  204. 2040  '* THE 'LOCATE' ARGUMENT IS DERIVED FROM
  205. 2050  '* INTEGER VALUES OF AZ AND EL.
  206. 2060  J=CINT(AZIM/6)+5
  207. 2070  I=CINT(20-(ELEV/5))
  208. 2080  IF I<=0 THEN I=1
  209. 2090  IF I>20 THEN I=20
  210. 2100  PNT$=STR$(INT(TIME/100))
  211. 2110  PNT$=RIGHT$(PNT$,LEN(PNT$)-1)
  212. 2120  IF LEN(PNT$)<2 THEN PNT$="0"+PNT$:GOTO 2120
  213. 2130  IF I=20 THEN 2180
  214. 2140  REM *** HIGHLIGHT BEST TIMES ON THE GRAPH
  215. 2150  IF BEST=1 THEN COLOR 15
  216. 2160  LOCATE I,J: PRINT "*";PNT$+"z"
  217. 2170  COLOR 7
  218. 2180  TIMECOUNT=TIMECOUNT+INCR
  219. 2190  IF TIMECOUNT-(INT(TIMECOUNT/100)*100)=>60 THEN TIMECOUNT=TIMECOUNT+40
  220. 2200  TIME=TIME+INCR
  221. 2210  COUNTR=1:ENDER=ENDER+1
  222. 2220  ROUNDS=1
  223. 2230  IF TIMECOUNT<FINISH THEN 1020
  224. 2240  IF WHICH=2 AND DIRECTION<9 THEN LOCATE 23,55: PRINT WAY$;" Path"
  225. 2250  IF WHICH=2 AND DIRECTION>8 THEN LOCATE 23,55:PRINT"Bearing"CINT(ANGLE)"<UNK! {00F8}>"
  226. 2260  IF WHICH=3 THEN NEXT DIRECTION:PRINT UL$;:GOSUB 4890:GOTO 2600
  227. 2270  IF BESTIME=0 THEN 2290
  228. 2280  LOCATE 23,30: PRINT "Best Time: "BESTIM$
  229. 2290  GOSUB 4960:CLS
  230. 2300  PRINT "                Shower: ";SHOWER$: PRINT
  231. 2310  PRINT" DAY","TIME (UTC)","AZIMUTH","ELEVATION"
  232. 2320  FOR K=1 TO ENDER-1
  233. 2330  LD$=STR$(LDATE(K)):LD$=RIGHT$(LD$,LEN(LD$)-1)
  234. 2340  IF LEN(LD$)<2 THEN LD$="0"+LD$:GOTO 2340
  235. 2350  LT$=STR$(LTIME(K)):LT$=RIGHT$(LT$,LEN(LT$)-1)
  236. 2360  IF LEN(LT$)<4 THEN LT$="0"+LT$:GOTO 2360
  237. 2370  PRINT "  "LD$;TAB(18)LT$;
  238. 2380  PRINT TAB(30)USING "###.#<UNK! {00F8}>";LAZIM(K);
  239. 2390  PRINT TAB(44)USING "###.#<UNK! {00F8}>";LELEV(K);:GOSUB 4890
  240. 2400  NEXT K
  241. 2410  PRINT UL$;
  242. 2420  GOSUB 4960:LOCATE 25,1:PRINT STRING$(79,32);:LOCATE 25,24:COLOR 0,7
  243. 2430  PRINT " Press 1 to continue or 0 to quit ";:COLOR 7,0
  244. 2440  Z$=INKEY$:IF Z$=""THEN 2440
  245. 2450  IF Z$="0"THEN 320
  246. 2460  IF Z$="1"THEN COUNTR=0:ENDER=0:PRINTED=0:BESTEL=999:GOTO 280
  247. 2470  GOTO 2440
  248. 2480  '
  249. 2490  '* FROM "ASTRONOMICAL CALENDAR 1985" BY GUY OTTWELL
  250. 2500  DATA QUADRANTIDS,282.80,1,4,14 hours,41.5,110,15,28,50,B,100
  251. 2510  DATA LYRIDS,31.4,4,21,2.3 days,47,Variable,18,8,32,BC,105
  252. 2520  DATA ETA AQUARIDS,44,5,4,3 days,67,21,22,20,-1,C2,115
  253. 2530  DATA ARIETIDS,75.0,6,5,Rich but small,37,60,2,56,23,Unknown,100
  254. 2540  DATA PERSEIDS,139.3,8,11,4.6 days,60,68,3,4,58,C2,110
  255. 2550  DATA DRACONIDS, 196.3,10,10,1.2 hours,21,42,17,28,54,C1,97
  256. 2560  DATA ORIONIDS, 207,10,20,2 days,67,35,6,20,15,C2,115
  257. 2570  DATA LEONIDS, 234.7,11,16,4 days,71,40,10,8,22,C2,150
  258. 2580  DATA GEMINIDS, 261.9,12,13,2.6 days,35,58,7,28,32,B,95
  259. 2590  '
  260. 2600  '.....end
  261. 2610  GOSUB 4960:GOTO 320
  262. 2620  '
  263. 2630  '.....SEXAGESIMAL TO DECIMAL CONVERSION
  264. 2640  S=1: A1=ABS(VAL(A$))
  265. 2650  IF LEFT$(A$,1)="-" THEN S=-1
  266. 2660  A=S*(A1+A2/60+A3/3600)
  267. 2670  RETURN
  268. 2680  '
  269. 2690  '.....GREENWICH MEAN SIDERIAL TIME CONVERSION
  270. 2700  HOUR=INT(TIME/100)
  271. 2710  MIN=TIME-(HOUR*100)
  272. 2720  IF MIN=>60 THEN TIME=TIME+40:GOTO 2700
  273. 2730  IF TIME>2400 THEN TIME=TIME-2400:DAY=DAY+1
  274. 2740  HOUR=HOUR/24:MIN=MIN/1440
  275. 2750  D=DAY+HOUR+MIN
  276. 2760  D1=INT(D):F=D-D1-0.5
  277. 2770  J=-INT(7*(INT((M+9)/12)+Y)/4)
  278. 2780  S=SGN(M-9):A=ABS(M-9)
  279. 2790  J1=INT(Y+S*INT(A/7))
  280. 2800  J1=-INT((INT(J1/100)+1)*3/4)
  281. 2810  J=J+INT(275*M/9)+D1+J1
  282. 2820  J=J+1.72103E+06+2+367*Y
  283. 2830  IF F>=0 THEN 2860
  284. 2840  F=F+1:J=J-1
  285. 2850  D=J-2.45154E+06
  286. 2860  T=D/36525:T1=INT(T)
  287. 2870  J0=T1*36525+2.45154E+06
  288. 2880  T2=(J-J0+0.5)/36525
  289. 2890  S=24110.5+184.813*T1
  290. 2900  S=S+8.64018E+06*T2
  291. 2910  S=S+0.093104*T*T
  292. 2920  S=S-6.198E-06*T*T*T
  293. 2930  S=S/86400:S=S-INT(S)
  294. 2940  S=24*(S+(F-0.5)*1.00274)
  295. 2950  IF S<0 THEN S=S+24
  296. 2960  IF S>24 THEN S=S-24
  297. 2970  RETURN
  298. 2980  '
  299. 2990  '.....graph diagram
  300. 3000  CLS:LOCATE 1,22:PRINT "Shower: "SHOWER$" ("M$"/"D$"/"Y$")"
  301. 3010  LOCATE 2,13
  302. 3020  PRINT "AZ, EL OF RADIANT AT PATH MIDPOINT: ";ABS(CINT(MIDLATD))"<UNK! {00F8}>"LA$".";
  303. 3030  PRINT "   ";ABS(CINT(MIDLOND))"<UNK! {00F8}>"LO$"."
  304. 3040  FOR I=2 TO 20
  305. 3050  LOCATE I,3:PRINT (90-(I*5))+10
  306. 3060  NEXT I
  307. 3070  LOCATE 5,1 : PRINT "E": LOCATE 6,1 : PRINT "L": LOCATE 7,1 : PRINT "E"
  308. 3080  LOCATE 8,1 : PRINT "V": LOCATE 9,1 : PRINT "A": LOCATE 10,1: PRINT "T"
  309. 3090  LOCATE 11,1: PRINT "I": LOCATE 12,1: PRINT "O": LOCATE 13,1: PRINT "N"
  310. 3100  '
  311. 3110  '.....set bottom axis
  312. 3120  FOR J=5 TO 65 STEP 5
  313. 3130  LOCATE 20,J-1:PRINT (J-5)*6
  314. 3140  NEXT J
  315. 3150  LOCATE 11,7:PRINT STRING$(62,"-")
  316. 3160  LOCATE 22,55:PRINT "Home QTH"ABS(MYLATD)"<UNK! {00F8}>"LA$".";ABS(MYLOND)"<UNK! {00F8}>"LO$"."
  317. 3170  RETURN
  318. 3180  '
  319. 3190  '.....title option 3
  320. 3200  CLS
  321. 3210  PRINT "Shower: ";SHOWER$ "   Date: "M$"/"D$"/"Y$"  Peak at ";ZU$+"z"
  322. 3220  PRINT "    GOOD TIMES"
  323. 3230  COLOR 15
  324. 3240  LOCATE 2,33: PRINT "BEST TIMES"
  325. 3250  COLOR 7
  326. 3260  HEADER=1
  327. 3270  RETURN
  328. 3280  '
  329. 3290  '.....CALCULATE ECLIPTIC LONGITUDE FROM ASTR.ALMANAC
  330. 3300  JC#=CDBL(J)
  331. 3310  FC#=CDBL(F)
  332. 3320  JD#=JC#+FC#
  333. 3330  REM *** JD# IS DOUBLE-PRECISION JULIAN DAY
  334. 3340  N#=JD#-2.45154E+06
  335. 3350  LONSUN#=280.46+(0.985647*N#)
  336. 3360  G#=357.528+(0.9856*N#)
  337. 3370  IF LONSUN#<0 THEN LONSUN#=LONSUN#+360
  338. 3380  IF G#<0 THEN G#=G#+360
  339. 3390  IF LONSUN#<0 THEN 3370
  340. 3400  IF G#<0 THEN 3380
  341. 3410  RCON#=180/3.14159
  342. 3420  LONSUNT#=LONSUN#+(1.915*SIN(G#/RCON#))+(0.02*SIN(2*(G#/RCON#)))
  343. 3430  RETURN
  344. 3440  '
  345. 3450  '.....bearing and distance
  346. 3460  U$="#####.#"
  347. 3470  IF DIRECTION<>9 THEN HISLATD=CIRLATD:HISLOND=CIRLOND
  348. 3480  DIFLOND=MYLOND-HISLOND
  349. 3490  MIDLATD=MYLATD-((MYLATD-HISLATD)/2)
  350. 3500  IF DIFLOND<-180 THEN DIFLOND=DIFLOND+360
  351. 3510  IF DIFLOND>180 THEN DIFLOND=DIFLOND-360
  352. 3520  '.....degrees to radians
  353. 3530  HISLAT=HISLATD*R1:HISLON=HISLOND*R1
  354. 3540  DIFLON=DIFLOND*R1
  355. 3550  '.....distance
  356. 3560  COSB=(SMYLAT*SIN(HISLAT))+(CMYLAT*COS(HISLAT)*COS(DIFLON))
  357. 3570  BETA=FNACOS(COSB)
  358. 3580  BETA2=BETA/R1
  359. 3590  '.....factor 69.05 for stat.mi., 111.2 for km
  360. 3600  DIST=BETA2*69.05
  361. 3610  '.....bearing
  362. 3620  COSA=(SIN(HISLAT)-(SMYLAT*COSB))/(CMYLAT*SIN(BETA))
  363. 3630  '.....corect round-off errors
  364. 3640  IF COSA>1 THEN COSA=1
  365. 3650  IF COSA<-1 THEN COSA=-1
  366. 3660  AZ=FNACOS(COSA)
  367. 3670  ANGLE=AZ/R1
  368. 3680  '* HAFLON IS THE LON OF A POINT BETWEEN HERE AND THERE
  369. 3690  HAF=CMYLAT*COS(MIDLATD*R1)
  370. 3700  HAFLON=FNACOS((COS(BETA/2)-(SMYLAT*SIN(MIDLATD*R1)))/HAF)
  371. 3710  IF DIFLOND>0 THEN ANGLE=360-ANGLE
  372. 3720  IF DIRECTION<>9 OR PRINTED=1 OR WHICH<>2 THEN 3790
  373. 3730  PRINT:PRINT " Distance="USING U$;DIST;
  374. 3740  PRINT " stat.miles ("USING U$;BETA2*111.2;
  375. 3750  PRINT "km):   Bearing=";USING U$;ANGLE;:PRINT "<UNK! {00F8}>"
  376. 3760  COLOR 0,7:PRINT " Press any key to continue ":COLOR 7,0
  377. 3770  IF INKEY$=""THEN 3770
  378. 3780  PRINTED=1
  379. 3790  IF ANGLE>180 THEN HAFLON=MYLON-HAFLON ELSE HAFLON=MYLON+HAFLON
  380. 3800  MIDLOND=HAFLON/R1
  381. 3810  RETURN
  382. 3820  '
  383. 3830  '.....READ DATA AND CALCULATE PEAK DATE/TIME
  384. 3840  FOR I=1 TO SHOWER
  385. 3850  READ SHOWER$,ELON,M,DAY,DURATION$,VELOCITY$
  386. 3860  READ RATE$,RAHOUR,RAMIN,DEC,CLASS$,HEIGHT
  387. 3870  NEXT I
  388. 3880  RESTORE
  389. 3890  COLOR 0,7:INPUT " ENTER: Year....";Y
  390. 3900  LOCATE CSRLIN-1:PRINT ".....ITERATION ON PROGRESS - PLEASE WAIT....."
  391. 3910  TIME=0
  392. 3920  COLOR 7,0:GOSUB 2690
  393. 3930  GOSUB 3290
  394. 3940  IF LONSUNT#>ELON THEN 3990
  395. 3950  DAY=DAY+1
  396. 3960  GOSUB 2690
  397. 3970  GOSUB 3290
  398. 3980  GOTO 3940
  399. 3990  IF LONSUNT#<=ELON THEN 4040
  400. 4000  E2=LONSUNT#
  401. 4010  DAY=DAY-1
  402. 4020  GOSUB 2690
  403. 4030  GOSUB 3290
  404. 4040  T=24*((ELON-LONSUNT#)/(E2-LONSUNT#))
  405. 4050  H0=INT(T)
  406. 4060  M1=INT(60*(T-H0)+0.5)
  407. 4070  GMT=100*H0+M1
  408. 4080  IF GMT<0 THEN DAY=DAY-1: GOTO 3920
  409. 4090  IF DAY<=31 THEN 4120
  410. 4100  DAY=DAY-31
  411. 4110  M=M+1
  412. 4120  CLS:LOCATE 2
  413. 4130  ZU$=STR$(GMT):ZU$=RIGHT$(ZU$,LEN(ZU$)-1)
  414. 4140  IF LEN(ZU$)<4 THEN ZU$="0"+ZU$:GOTO 4140
  415. 4150  M$=STR$(M):IF VAL(M$)<10 THEN M$=" 0"+RIGHT$(M$,1)
  416. 4160  D$=STR$(DAY):IF VAL(D$)<10 THEN D$=" 0"+RIGHT$(D$,1)
  417. 4170  M$=RIGHT$(M$,2):D$=RIGHT$(D$,2):Y$=RIGHT$(STR$(Y),4):
  418. 4180  PRINT " The";:COLOR 0,7:PRINT "OFF";SHOWER$;"INKEY$";:COLOR 7,0
  419. 4190  PRINT "meteor shower will peak at "ZU$" UTC on ";
  420. 4200  PRINT M$"/"D$"/"Y$" (mo/da/yr)"
  421. 4210  IF WHICH>1 THEN 900
  422. 4220  PRINT UL$;
  423. 4230  PRINT " Duration above Quarter Max.... ";DURATION$
  424. 4240  PRINT " Velocity...................... ";VELOCITY$" km/sec"
  425. 4250  PRINT " Average Height of Ionization.. ";HEIGHT"km"
  426. 4260  PRINT " Meteors per hour (approx.).... ";RATE$
  427. 4270  PRINT " E.L. used for calculation..... ";ELON"<UNK! {00F8}>  (Epoch 2000.0)"
  428. 4280  PRINT " R.A. of Radiant............... ";RAHOUR"hr"RAMIN;"min"
  429. 4290  PRINT " Declination................... ";DEC"<UNK! {00F8}>"
  430. 4300  PRINT " Ceplecha's Class.............. ";CLASS$
  431. 4310  TIME=GMT:GOSUB 2690:GOSUB 3290:ROUNDLON=INT(LONSUNT#*1000)/1000
  432. 4320  PRINT
  433. 4330  PRINT "  (the E.L.values below are for checking the";
  434. 4340  PRINT "  calculated E.L. against the Nautical Almanac)"
  435. 4350  PRINT
  436. 4360  PRINT " E.L. at "ZU$" UTC =";USING "####.###";ROUNDLON;:PRINT "<UNK! {00F8}>"
  437. 4370  TIME=0: GOSUB 2690: GOSUB 3290: ROUNDLON=INT(LONSUNT#*1000)/1000
  438. 4380  DEGLON=INT(LONSUNT#): MINLON=INT((LONSUNT#-DEGLON)*60)
  439. 4390  SECLON=(INT((((LONSUNT#-DEGLON)*60)-MINLON)*60)*100)/100
  440. 4400  PRINT " E.L. at 0000 UTC =";USING "####.###";ROUNDLON;:PRINT "<UNK! {00F8}> (";
  441. 4410  PRINT DEGLON;"<UNK! {00F8}>";MINLON;"'";SECLON;CHR$(34);" )"
  442. 4420  GOTO 2600
  443. 4430  '
  444. 4440  '.....CALCULATE LAT, LON OF A 500-MI RADIUS CIRCLE (PATH MIDPOINT)
  445. 4450  COSA2=COS(ANGLE*R1): 'ANGLE IS THE BEARING FROM YOUR QTH
  446. 4460  '* CIRLATD IS THE LATITUDE OF THE POINT
  447. 4470  CIRLAT=FNARSIN ((COSA2*CMYLAT*SINBETA2)+(SMYLAT*COSBETA2))
  448. 4480  CIRLATD=CIRLAT/R1
  449. 4490  '* CIRLOND IS THE LONGITUDE OF THE POINT
  450. 4500  CIRLON= (COSBETA2-(SMYLAT*SIN(CIRLAT)))/(CMYLAT*COS(CIRLAT))
  451. 4510  IF CIRLON>1 THEN CIRLON=1
  452. 4520  IF CIRLON<-1 THEN CIRLON=-1
  453. 4530  CIRLON=FNACOS(CIRLON)
  454. 4540  IF ANGLE>180 THEN CIRLON=MYLON-CIRLON ELSE CIRLON=MYLON+CIRLON
  455. 4550  CIRLOND=CIRLON/R1
  456. 4560  RETURN
  457. 4570  '
  458. 4580  '.....initialize variables
  459. 4590  P=3.14159:R1=P/180
  460. 4600  MYLON=MYLOND*R1:MYLAT=MYLATD*R1
  461. 4610  CMYLAT=COS(MYLAT):SMYLAT=SIN(MYLAT)
  462. 4620  CIRRANGE=500:CIRBETA2=(CIRRANGE/69.05)*R1: 'FOR KM CHANGE 69.05 TO 111.2
  463. 4630  COSBETA2=COS(CIRBETA2):SINBETA2=SIN(CIRBETA2)
  464. 4640  RETURN
  465. 4650  '
  466. 4660  '.....preface
  467. 4670  TB=7
  468. 4680  PRINT TAB(TB);
  469. 4690  PRINT "This program calculates the peak time for major meteor showers."
  470. 4700  PRINT TAB(TB);
  471. 4710  PRINT "It also provides information concerning the optimum times for"
  472. 4720  PRINT TAB(TB);
  473. 4730  PRINT "particular paths in graphic and tabular form. The program is an"
  474. 4740  PRINT TAB(TB);
  475. 4750  PRINT "edited version of an original program by Michael R. Owen, W9IP,"
  476. 4760  PRINT TAB(TB);
  477. 4770  PRINT "and other programs by Russ Wicker, W4WD, and Joe Reisert, W1JR."
  478. 4780  PRINT
  479. 4790  PRINT TAB(TB);
  480. 4800  PRINT "References:"
  481. 4810  PRINT TAB(TB);
  482. 4820  PRINT "Astronomical Calendar 1985, by G.Ottwell, Furman U., Greenville SC."
  483. 4830  PRINT TAB(TB);
  484. 4840  PRINT "Astronomical Almanac for 1985, page C24.
  485. 4850  PRINT TAB(TB);
  486. 4860  PRINT "The 1997 ARRL Handbook for Radio Amateurs, page 21.13."
  487. 4870  RETURN
  488. 4880  '
  489. 4890  '.....end of page
  490. 4900  LN=CSRLIN
  491. 4910  IF LN<24 THEN PRINT " ":GOTO 4940
  492. 4920  GOSUB 4960:GOTO 4930
  493. 4930  CLS
  494. 4940  RETURN
  495. 4950  '
  496. 4960  'HARDCOPY
  497. 4970  GOSUB 5080:LOCATE 25,2:COLOR 14,6
  498. 4980  PRINT " Press 1 to print screen, 2 to print screen & ";
  499. 4990  PRINT "advance paper, or 3 to continue.";:COLOR 7,0
  500. 5000  Z$=INKEY$:IF Z$="3"THEN GOSUB 5080:RETURN
  501. 5010  IF Z$="1"OR Z$="2"THEN GOSUB 5080:GOTO 5030
  502. 5020  GOTO 5000
  503. 5030  FOR QX=1 TO 24:FOR QY=1 TO 80
  504. 5040  LPRINT CHR$(SCREEN(QX,QY));
  505. 5050  NEXT QY:NEXT QX
  506. 5060  IF Z$="2"THEN LPRINT CHR$(12)
  507. 5070  GOTO 4970
  508. 5080  LOCATE 25,1:PRINT STRING$(80,32);:RETURN
  509.